CEOI 1996, Slovacia, octombrie
CAREU CU GAURI (40 puncte)

	Penru criptarea mesajelor, vom folosi careuri cu gauri. Numim careu 
de ordin N un careu cu 2Nx2N patratele dintre care N2 sunt perforate (gauri);
vezi fig.1.
	Se considera un cuvant de lungime 4N2. El va fi criptat sub forma unei
matrici patrate 2Nx2N, folosind un careu de ordin N, dupa cum urmeaza. Primele 
N2 litere vor fi puse in ordine in matricea finala, pe pozitiile libere, conform 
careului cu gauri. Se roteste apoi careul cu 90 de grade in sensul acelor de 
ceasornic; urmatoarele N2 litere ale cuvantului vor fi plasate in matricea 
finala pe pozitiile corespunzatoare gaurilor "noului" careu. Se continua in 
acest mod pana cand toate literele careului au fost plasate in matricea finala. 
De exemplu, pentru cuvantul HELLOYELLOWWORLD si careul din fig. 1, dupa pasul 1
vor fi plasate primele patru litere ale sale conform figurii 2. Sunt necesare 
in continuare trei rotiri ale careului si se obtine matricea finala din fig.3. 

	Fig.1			Fig.2			Fig.3
	O###			H###			HOOY
	##O#			##E#			LREO
	O##O			L##L			LWEL
	####			####			LLDW

	Careul cu gauri dat este considerat corect, in sensul ca dupa fiecare 
rotire gaurile sale corespund unor pozitii neocupate in matricea finala.
	Din pacate careul cu gauri initial s-a pierdut, dar se cunoaste cuvantul 
de plecare si matricea finala (criptarea sa). Se cere sa reconstituiti careul
cu gauri pe baza caruia s-a facut criptarea.

Intrarea:
	Prima linie contine numarul intreg N (1<=N<=10). Linia a doua contine 
cele 4N2 caractere (litere mari) ale cuvantului ce a fost criptat. Urmatoarele 
2N linii contin matricea finala ce reprezinta criptarea cuvantului (pe fiecare 
linie apar 2N caractere).

Iesirea:
	Fisierul de iesire va contine careul cu gauri cautat astfel: 2N linii 
cu cate 2N caractere, ce pot fi litera mare O (pentru gaura) sau # (pentru 
patratel nedecupat).

Exemplu:

GRID.IN						GRID.OUT
2						O###
HELLOYELLOWWORLD				##O#
HOOY						O##O
LREO						####
LWEL							
LLDW
----------------------------
Solutia 1 (Cristian Cadar)
uses crt;
type
    tablou=array[1..20,1..20] of char;
var
   nr,n,n2,i,j,k:integer;
   a,b,c:tablou;
   st:string;
   s:array[1..100,1..2] of integer;
   f:text;

procedure citire;
begin
     clrscr;
     write('Fisier intrare:');
     readln(st);
     assign(f,st);
     reset(f);
     readln(f,n);
     readln(f,st);
     n2:=length(st) div 4;
     for i:=1 to 2*n do
         begin
              for j:=1 to 2*n do
                  read(f,a[i,j]);
              readln(f);
         end;
     close(f);
end;

procedure rec(x,y,k:byte);

function egal(a,b:tablou):boolean;
var
   i,j:integer;
begin
     egal:=true;
     for i:=1 to n do
         for j:=1 to n do
             if a[i,j]<>b[i,j]
                then
                    begin
                         egal:=false;
                         exit;
                    end;
end;

function verif:boolean;
var
   i,j,k:integer;
begin
     fillchar(b,sizeof(b),'#');
     for i:=1 to n2 do
         b[s[i,1],s[i,2]]:='0';
     for k:=1 to 3 do
         begin
              nr:=0;
              c:=b;
              for i:=1 to 2*n do
                  for j:=1 to 2*n do
                      if b[i,j]='0'
                         then
                             begin
                                  inc(nr);
                                  b[i,j]:=st[n2*(k-1)+nr];
                             end;
              for i:=1 to 2*n do
                  for j:=1 to 2*n do
                      if c[i,j]='0'
                         then b[j,2*n-i+1]:=c[i,j];
         end;
     for i:=1 to 2*n do
         for j:=1 to 2*n do
             if b[i,j]='0'
                then
                    begin
                         inc(nr);
                         b[i,j]:=st[n2*(k-1)+nr];
                    end;
     verif:=egal(a,b);
end;

procedure tipar;
begin
     fillchar(b,sizeof(b),'#');
     for i:=1 to n2 do
         b[s[i,1],s[i,2]]:='0';
     assign(f,'output.txt');
     rewrite(f);
     for i:=1 to 2*n do
         begin
              for j:=1 to 2*n do
                  write(f,b[i,j]);
              writeln(f);
         end;
     close(f);
end;

begin
     if k=n2+1
        then
            begin
                 if verif
                    then tipar;
            end
        else
            begin
                 repeat
                       if y=2*n
                          then
                              if x<2*n
                                 then
                                     begin
                                          inc(x);
                                          y:=1;
                                     end
                                 else exit
                          else inc(y);
                 until a[x,y]=st[k];
                 s[k,1]:=x;
                 s[k,2]:=y;
                 rec(x,y,k+1);
            end;
end;

procedure generare;
begin
     rec(1,0,1);
end;

begin
     citire;
     generare;
end.
------------------------------
Solutia 2 (Valentin Gheorghita)
program careu;
uses crt;
type sir=array[1..400] of char;
var f:text;
    nume:string;
    cuv:sir;
    a,b:array[1..20,1..20] of char;
    n,i,j:integer;

{function gaseste:integer;
 var nr:array[1..4] of integer;
     ch:char;
     new:string;
     pz,i,j,max:integer;
     lit:array['A'..'Z'] of boolean;
 begin
  for i:=1 to 4 do
   begin
    for ch:='A' to 'Z' do
     lit[ch]:=false;
    for j:=1 to n*n do
     lit[cuv[(i-1)*n*n+j]]:=true;
    nr[i]:=0;
    for ch:='A' to 'Z' do
     if lit[ch] then nr[i]:=nr[i]+1;
   end;
  max:=0;pz:=0;
  for i:=1 to 4 do
   if nr[i]>max then begin
                      max:=nr[i];
                      pz:=i;
                     end;
  gaseste:=pz;
  for i:=(pz-1)*n*n+1 to 4*n*n do
   new[i-(pz-1)*n*n]:=cuv[i];
  for i:=1 to (pz-1)*n*n do
   new[4*n*n-(pz-1)*n*n+i]:=cuv[i];
  for i:=1 to 4*n*n do
   cuv[i]:=new[i];
 end;
 }
function test(pz:integer):boolean;
 var tst:boolean;
     i,j,nr:integer;
 begin
  nr:=0;
  i:=1;
  j:=1;
  tst:=true;
  while tst and (nr<pz) do
   begin
    if b[i,j]='0' then begin
                        nr:=nr+1;
                        if a[i,j]<>cuv[nr] then tst:=false;
                       end;
    j:=j+1;
    if j=2*n+1 then begin
                     i:=i+1;
                     j:=1;
                    end;
   end;
  test:=tst;
 end;

function solutie:boolean;
 var tst:boolean;
     nr,i,j:integer;
 begin
  nr:=0;
  tst:=true;
  for i:=1 to n*2 do
   for j:=1 to 2*n do
    if b[i,j]='0' then begin
                        nr:=nr+1;
                        if a[i,j]<>cuv[nr] then tst:=false;
                       end;
  for j:=1 to n*2 do
   for i:=2*n downto 1 do
    if b[i,j]='0' then begin
                        nr:=nr+1;
                        if a[j,2*n-i+1]<>cuv[nr] then tst:=false;
                       end;
  for i:=n*2 downto 1 do
   for j:=2*n downto 1 do
    if b[i,j]='0' then begin
                        nr:=nr+1;
                        if a[2*n-i+1,2*n-j+1]<>cuv[nr] then tst:=false;
                       end;
  for j:=n*2 downto 1 do
   for i:=1 to 2*n do
    if b[i,j]='0' then begin
                        nr:=nr+1;
                        if a[2*n-j+1,i]<>cuv[nr] then tst:=false;
                       end;
  solutie:=tst;
 end;

procedure tipar;
 begin
  for i:=1 to 2*n do
     begin
      for j:=1 to 2*n do
      write(b[i,j]);
      writeln;
     end;
    halt;
 end;

procedure recurs(pz:integer);
 var i,j,l,c:integer;
 begin
  if pz=n*n+1 then begin
                    if solutie then tipar;
                   end
  else
  for i:=1 to 2 do
   for j:=1 to 2 do
    begin
     l:=(pz div n)+1;
     if pz mod n = 0 then l:=l-1;
     c:=pz mod n;
     if c=0 then c:=n;
     l:=(l-1)*2;
     c:=(c-1)*2;
     b[l+i,c+j]:='0';
     if (b[c+j,2*n-l-i+1]='*') and (b[2*n-l-i+1,1+2*n-c-j]='*')
         and (b[2*n+1-c-j,l+i]='*') then
     if test(pz) then recurs(pz+1);
     b[l+i,c+j]:='*';
    end;
 end;

begin
 clrscr;
 write('Introduceti numele fisierului de intrare : ');
 readln(nume);
 assign(f,nume);
 reset(f);
 readln(f,n);
 for i:=1 to 4*n*n do
  read(f,cuv[i]);
 readln(f);
 for i:=1 to 2*n do
  begin
   for j:=1 to 2*n do
    read(f,a[i,j]);
   readln(f);
  end;
 close(f);
 for i:=1 to 2*n do
  for j:=1 to 2*n do
   b[i,j]:='*';
 recurs(1);
end.
-------------------------
Solutia 3 (Dragos Vingarzan)
type mb=array [1..20,1..20] of boolean;
var p,q,r:mb;
    x,pasi,lcuv,i,j,k,l,m,n:longint;
    n2:longint;
    f,fo:text;
    s,cuv:string;
    a,b:array [1..100,1..100] of char;

procedure roteste(var p:mb);
var i,j:longint;
    q:mb;
begin
 for i:=1 to 2*n do
  for j:=1 to 2*n do
   q[i,j]:=p[2*n-j+1,i];
 for i:=1 to 2*n do
  for j:=1 to 2*n do
   p[i,j]:=q[i,j];
end;

procedure verifica(r:mb);
var i,j,k,l,ii,jj:integer;
    p:boolean;
    q:mb;
begin
 for i:=1 to 2*n do
  for j:=1 to 2*n do
   q[i,j]:=r[i,j];
 i:=1;
 for k:=1 to lcuv div n2 do
  begin
   for ii:=1 to 2*n do
    for jj:=1 to 2*n do
     if not(q[ii,jj]) then begin
                       b[ii,jj]:=cuv[i];
                       inc(i);
                      end;
   roteste(q);
  end;
 for ii:=1 to 2*n do
  for jj:=1 to 2*n do
   if i>lcuv then begin
                   ii:=2*n;
                   jj:=2*n;
                  end
             else if not(q[ii,jj]) then begin
                                    b[ii,jj]:=cuv[i];
                                    inc(i);
                                   end;
 p:=true;
 for i:=1 to 2*n do
  for j:=1 to 2*n do
   if a[i,j]<>b[i,j] then p:=false;
 if p then begin
            for i:=1 to 2*n do
             begin
              for j:=1 to 2*n do
               if not(r[i,j]) then write(fo,'O')
                              else write(fo,'#');
              writeln(fo);
             end;
            writeln(fo);
            close(fo);
            close(f);
            halt;
           end;
end;

procedure aleg(l:integer);
var i,j:integer;
begin
 if l>k then verifica(r)
        else begin
              for i:=1 to 2*n do
               for j:=1 to 2*n do
                if r[i,j] then begin
                                r[i,j]:=false;
                                aleg(l+1);
                                r[i,j]:=true;
                               end;
             end;
end;

begin
 assign(f,'grid.in');
 reset(f);
 assign(fo,'grid.out');
 rewrite(fo);
 readln(f,n);
 n2:=sqr(n);
 readln(f,cuv);
 for i:=1 to 2*n do
  begin
   readln(f,s);
   for j:=1 to 2*n do
    a[i,j]:=s[j];
  end;
 lcuv:=length(cuv);
 for i:=1 to 2*n do
  for j:=1 to 2*n do
   begin
    p[i,j]:=false;
    r[i,j]:=true;
   end;
 pasi:=0;
 for i:=1 to lcuv div n2 do
  begin
   for k:=1 to 2*n do
    for l:=1 to 2*n do
     q[k,l]:=false;
   for j:=(i-1)*n2+1 to i*n2 do
    begin
     x:=0;
     for k:=1 to 2*n do
      for l:=1 to 2*n do
       if a[k,l]=cuv[j] then inc(x);
     for k:=1 to 2*n do
      for l:=1 to 2*n do
       if a[k,l]=cuv[j] then begin
                              q[k,l]:=true;
                              if x=1 then r[k,l]:=false;
                             end;
    end;
   for k:=1 to 2*n do
    for l:=1 to 2*n do
     if r[k,l] then p[k,l]:=p[k,l] and q[k,l];
   inc(pasi);
   pasi:=pasi mod 4;
   roteste(p);
   roteste(r);
  end;
 if pasi<>0 then
  for i:=1 to 4-pasi do
   begin
    roteste(p);
    roteste(r);
   end;
 k:=n2;
 for i:=1 to 2*n do
  for j:=1 to 2*n do
   if not(r[i,j]) then dec(k);
 aleg(1);
 close(f);
 close(fo);
end.
=================================
test 1
2
HELLOYELLOWWORLD
HOOY
LREO
LWEL
LLDW
-----------------
test 2:
2
ABABABABABABABAB
ABAB
ABAB
ABAB
ABAB
-----------------
test 3:
3
THISPOORMESSAGEISASLONGASITSHOULDBEE
STSLHH
OESINS
AOGUAL
GSEPID
BOSEEO
ISRMTA
-------------------
test 4:
1
CEIO
CE
OI
---------------------
Test 5:
3
AABCBBACBACBBACBBACBBABCBACACABCBBAC
CAAAAC
BBCACB
BBBBAA
BCBBAC
BABCBC
BAACCB
------------------------
test 6:
5
ANDTHISCODEDMESSAGEISGOINGTOBEVERYEASYBECAUSEITHASMANYDIFFERENTLETTERSALTHOUGHITHASONEHUNDREDLETTERS
UMGAATGONN
BEDHYTHVDI
ISCIOETRYF
FHEEDARSEA
DOMENNSYEH
BEUNCESTAL
DEUSSTRAEG
EEDILTIERS
TSEALGHTTT
HOEARIOSNS
----------------------------
test 7:
6
AAVFGQHEJKCLBVBHWJTIRVRHEILGUGMDVHTYMWUADDMAOATQTRNFROXQYGQHCTMWMOXRIARYTSEDWTOVRHCPHVEGNYEDGEOMHDPSSCBBCTUJPKSMIUUDCBBEQFOGJUHHQRWHLHTSNSKNOWQC
PKAATSMWESUV
FADDDMGWQITH
OVUREJHUMKCA
ODCACLBBPEQT
BQHVVEBTHRGF
WONNGJJUFRTH
OYHQXEQYIRGD
QRWGHEVORHLM
HHCETMHWTDMS
NIPSOLSSGXUG
CMRBDBIKVNOC
TWAHQCTYUJRY
-------------------------------
test 8:
8
AAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAA
AAAAAAAAAAAAAAAA
AAAAAAAAAAAAAAAA
AAAAAAAAAAAAAAAA
AAAAAAAAAAAAAAAA
AAAAAAAAAAAAAAAA
AAAAAAAAAAAAAAAA
AAAAAAAAAAAAAAAA
AAAAAAAAAAAAAAAA
AAAAAAAAAAAAAAAA
AAAAAAAAAAAAAAAA
AAAAAAAAAAAAAAAA
AAAAAAAAAAAAAAAA
AAAAAAAAAAAAAAAA
AAAAAAAAAAAAAAAA
AAAAAAAAAAAAAAAA
AAAAAAAAAAAAAAAA
-------------------------------
Test 9:
7
AAVFGQHEJKCLBVBHWJTIRVRHEILGUGMDVHTYMWUADDMAOATQTRNFROXQYGQHCTMWMOXRIARYTSEDWTOVRHCPHVEGNYEDGEOMHDPSSCBBCTUJPKSMIUUDCBBEQFOGJUHHQRWHLHTSNSKNOWQCLKCBNQCXURXGRSMQDFXJDYHBCVNRCQAHWNILWIIMBVTEXMDWKFUO
APRSBNAQVNFCRO
FSXCBBGCQHQYXU
TEJGURQKXGHCJP
CLBVRSMBKHTSQD
WFMXIMUJDYJHBT
CVUWDNCBIBRVRR
EMCQQOAHHWEFXR
NIIOIAGRLLYTWG
JSUHUHGMEDIVDW
QTORVRHHITCYPW
HVMMHWLEGNHTSN
UABVYESTDDEKND
GEXMOWMQAOADTC
WKOFULMKHDQOTC
----------------------------
Test 10:
8
AAVFGQHEJKCLBVBHWJTIRVRHEILGUGMDVHTYMWUADDMAOATQTRNFROXQYGQHCTMWMOXRIARYTSEDWTOVRHCPHVEGNYEDGEOMHDPSSCBBCTUJPKSMIUUDCBBEQFOGJUHHQRWHLHTSNSKNOWQCLKCBNQCXURXGRSMQDFXJDYHBCVNRCQAHWNILWIIMBVTEXMDWKFUOCPXNILFERYPRNCSDFWRKYDAEAJJJCLMLQUOGJOVPGRNVJJPTLFRUSWETGHRL
MAAVOKXRFQFRIGWH
AUORQHELJYKTCSLE
CBVHPXTNDBWHTOWV
JITSLRNSKHCNFEOP
HIRVWRVREHYPEIGQ
RNLGCNLUYCKECGDM
GDSVDBHEOMFHWRDN
QKTPYMWUSCSCYADX
DBUBAEDARXGRJSCM
AJTUJJCLMMOPQKDL
FQXAUTSOJQGTDYMI
RJHBUUCOVNRNVDCP
GFCBRRNOXQVBYQEA
JHJPWTNLQGFOQILG
FWRIUISMHBVTWJUE
CTETMXWHGHHRMDWL
========================================
